home *** CD-ROM | disk | FTP | other *** search
/ Hardcore Visual Basic 5.0 (2nd Edition) / Hardcore Visual Basic 5.0 - Second Edition (1997)(Microsoft Press).iso / Code / DROPST~1.CTL < prev    next >
Text File  |  1997-06-14  |  9KB  |  283 lines
  1. VERSION 5.00
  2. Begin VB.UserControl XDropStack 
  3.    ClientHeight    =   1170
  4.    ClientLeft      =   0
  5.    ClientTop       =   0
  6.    ClientWidth     =   2145
  7.    ScaleHeight     =   1170
  8.    ScaleWidth      =   2145
  9.    ToolboxBitmap   =   "dropstack.ctx":0000
  10.    Begin VB.ComboBox cbo 
  11.       Height          =   288
  12.       ItemData        =   "dropstack.ctx":00FA
  13.       Left            =   120
  14.       List            =   "dropstack.ctx":00FC
  15.       TabIndex        =   0
  16.       Top             =   240
  17.       Width           =   804
  18.    End
  19. End
  20. Attribute VB_Name = "XDropStack"
  21. Attribute VB_GlobalNameSpace = False
  22. Attribute VB_Creatable = True
  23. Attribute VB_PredeclaredId = False
  24. Attribute VB_Exposed = True
  25. Option Explicit
  26.  
  27. Public Enum EErrorDropStack
  28.     eeBaseDropStack = 13710     ' XDropStack
  29. End Enum
  30.  
  31. Private cMaxCount As Integer
  32. Private fInUpdate As Boolean
  33. Private fCompleted As Boolean
  34.  
  35. 'Event Declarations:
  36. Event Change()
  37. Attribute Change.VB_Description = "Occurs when the contents of a control have changed."
  38. Event Completed(Text As String)
  39.  
  40. Private Sub UserControl_Resize()
  41.     BugLocalMessage "XDropStack UserControl_Resize"
  42.     cbo.Left = 0
  43.     cbo.Top = 0
  44.     cbo.Width = Width
  45.     Height = cbo.Height
  46. End Sub
  47.  
  48. Public Property Get ForeColor() As OLE_COLOR
  49. Attribute ForeColor.VB_Description = "Returns/sets the foreground color used to display text and graphics in an object."
  50.     ForeColor = cbo.ForeColor
  51. End Property
  52.  
  53. Public Property Let ForeColor(ByVal clrForeColor As OLE_COLOR)
  54.     cbo.ForeColor() = clrForeColor
  55.     PropertyChanged "ForeColor"
  56. End Property
  57.  
  58. Public Property Get Font() As Font
  59. Attribute Font.VB_Description = "Returns a Font object."
  60. Attribute Font.VB_UserMemId = -512
  61.     Set Font = cbo.Font
  62. End Property
  63.  
  64. Public Property Set Font(ByVal fntFont As Font)
  65.     Set cbo.Font = fntFont
  66.     PropertyChanged "Font"
  67. End Property
  68.  
  69. Public Property Get List() As Collection
  70. Attribute List.VB_Description = "Returns/sets the items contained in a control's list portion."
  71.     Dim n As Collection, i As Integer
  72.     Set n = New Collection
  73.     For i = 0 To cbo.ListCount - 1
  74.         n.Add cbo.List(i)
  75.     Next
  76.     Set List = n
  77. End Property
  78.  
  79. Public Property Set List(n As Collection)
  80. With cbo
  81.     ' Remove any old items and add new list
  82.     If .ListCount Then .Clear
  83.     Dim v As Variant
  84.     For Each v In n
  85.         If VarType(v) = vbString Then
  86.             If v <> sEmpty Then .AddItem v
  87.         End If
  88.     Next
  89.     ' Select first item
  90.     .Refresh
  91.     fInUpdate = True
  92.     If .ListCount Then .ListIndex = 0
  93.     fInUpdate = False
  94. End With
  95. End Property
  96.  
  97. Public Sub Refresh()
  98. Attribute Refresh.VB_Description = "Forces a complete repaint of a object."
  99.     cbo.Refresh
  100. End Sub
  101.  
  102. Public Property Get Appearance() As Integer
  103. Attribute Appearance.VB_Description = "Returns/sets whether or not an object is painted at run time with 3-D effects."
  104.     Appearance = cbo.Appearance
  105. End Property
  106.  
  107. Public Property Get BackColor() As OLE_COLOR
  108. Attribute BackColor.VB_Description = "Returns/sets the background color used to display text and graphics in an object."
  109.     BackColor = cbo.BackColor
  110. End Property
  111.  
  112. Public Property Let BackColor(ByVal clrBackColor As OLE_COLOR)
  113.     cbo.BackColor() = clrBackColor
  114.     PropertyChanged "BackColor"
  115. End Property
  116.  
  117. Public Property Get hWnd() As Long
  118.     hWnd = cbo.hWnd
  119. End Property
  120.  
  121. Public Property Get Count() As Integer
  122. Attribute Count.VB_Description = "Returns the number of items in the list portion of a control."
  123. Attribute Count.VB_MemberFlags = "400"
  124.     Count = cbo.ListCount
  125. End Property
  126.  
  127. Public Property Get MaxCount() As Long
  128.     MaxCount = cMaxCount
  129. End Property
  130.  
  131. Public Property Let MaxCount(ByVal cMaxCountA As Long)
  132.     cMaxCount = cMaxCountA
  133. End Property
  134.  
  135. Public Property Get MouseIcon() As Picture
  136. Attribute MouseIcon.VB_Description = "Sets a custom mouse icon."
  137.     Set MouseIcon = cbo.MouseIcon
  138. End Property
  139.  
  140. Public Property Set MouseIcon(ByVal picMouseIcon As Picture)
  141.     Set cbo.MouseIcon = picMouseIcon
  142. End Property
  143.  
  144. Public Property Get MousePointer() As MousePointerConstants
  145. Attribute MousePointer.VB_Description = "Returns/sets the type of mouse pointer displayed when over part of an object."
  146.     MousePointer = cbo.MousePointer
  147. End Property
  148.  
  149. Public Property Let MousePointer(ByVal ordMousePointer As MousePointerConstants)
  150.     cbo.MousePointer() = ordMousePointer
  151.     PropertyChanged "MousePointer"
  152. End Property
  153.  
  154. Public Property Get SelLength() As Long
  155. Attribute SelLength.VB_Description = "Returns/sets the number of characters selected."
  156. Attribute SelLength.VB_MemberFlags = "400"
  157.     SelLength = cbo.SelLength
  158. End Property
  159.  
  160. Public Property Let SelLength(ByVal cSelLength As Long)
  161.     cbo.SelLength() = cSelLength
  162. End Property
  163.  
  164. Public Property Get SelStart() As Long
  165. Attribute SelStart.VB_Description = "Returns/sets the starting point of text selected."
  166. Attribute SelStart.VB_MemberFlags = "400"
  167.     SelStart = cbo.SelStart
  168. End Property
  169.  
  170. Public Property Let SelStart(ByVal iSelStart As Long)
  171.     cbo.SelStart() = iSelStart
  172. End Property
  173.  
  174. Public Property Get SelText() As String
  175. Attribute SelText.VB_Description = "Returns/sets the string containing the currently selected text."
  176. Attribute SelText.VB_MemberFlags = "400"
  177.     SelText = cbo.SelText
  178. End Property
  179.  
  180. Public Property Let SelText(ByVal sSelText As String)
  181.     cbo.SelText() = sSelText
  182. End Property
  183.  
  184. Public Property Get Text() As String
  185. Attribute Text.VB_Description = "Returns/sets the text contained in the control."
  186. Attribute Text.VB_UserMemId = 0
  187. Attribute Text.VB_MemberFlags = "400"
  188.     Text = cbo.Text
  189. End Property
  190.  
  191. Public Property Let Text(ByVal sText As String)
  192.     If sText = sEmpty Then Exit Property
  193.     UpdateItem sText
  194.     PropertyChanged "Text"
  195. End Property
  196.  
  197. Public Property Get ItemData() As Long
  198.     If cbo.ListCount Then ItemData = cbo.ItemData(0)
  199. End Property
  200.  
  201. Public Property Let ItemData(ByVal iItemData As Long)
  202.     If cbo.ListCount Then cbo.ItemData(0) = iItemData
  203. End Property
  204.  
  205. Public Sub Clear()
  206. Attribute Clear.VB_Description = "Clears the contents of a control or the system Clipboard."
  207.     cbo.Clear
  208. End Sub
  209.  
  210. Private Sub cbo_Click()
  211.     If fInUpdate Then Exit Sub
  212.     UpdateItem cbo.Text
  213. End Sub
  214.  
  215. Private Sub cbo_Change()
  216.     fCompleted = False
  217.     RaiseEvent Change
  218. End Sub
  219.  
  220. Private Sub cbo_KeyUp(KeyCode As Integer, Shift As Integer)
  221.     Select Case KeyCode
  222.     Case vbKeyReturn, vbKeyEscape ' , vbKeyTab
  223.         Text = cbo.Text
  224.     End Select
  225. End Sub
  226.  
  227. Private Sub cbo_LostFocus()
  228.     BugLocalMessage "XDropStack cbo_LostFocus"
  229.     If fCompleted = False Then Text = cbo.Text
  230. End Sub
  231.  
  232. ' Initialize Properties for User Control
  233. Private Sub UserControl_InitProperties()
  234.     BugLocalMessage "XDropStack UserControl_InitProperties"
  235.     Extender.Name = UniqueControlName("drop", Extender)
  236. End Sub
  237.  
  238. ' Load property values from storage
  239. Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
  240.     BugLocalMessage "XDropStack UserControl_ReadProperties"
  241.     cbo.BackColor = PropBag.ReadProperty("BackColor", &H80000005)
  242.     cbo.ForeColor = PropBag.ReadProperty("ForeColor", &H80000008)
  243.     Set Font = PropBag.ReadProperty("Font", Ambient.Font)
  244.     cMaxCount = PropBag.ReadProperty("MaxCount", 0)
  245.     Set MouseIcon = PropBag.ReadProperty("MouseIcon", Nothing)
  246.     cbo.MousePointer = PropBag.ReadProperty("MousePointer", 0)
  247. End Sub
  248.  
  249. ' Write property values to storage
  250. Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
  251.     BugLocalMessage "XDropStack UserControl_WriteProperties"
  252.     Call PropBag.WriteProperty("BackColor", cbo.BackColor, &H80000005)
  253.     Call PropBag.WriteProperty("ForeColor", cbo.ForeColor, &H80000008)
  254.     Call PropBag.WriteProperty("Font", Font, Ambient.Font)
  255.     Call PropBag.WriteProperty("MaxCount", cMaxCount, 0)
  256.     Call PropBag.WriteProperty("MouseIcon", MouseIcon, Nothing)
  257.     Call PropBag.WriteProperty("MousePointer", cbo.MousePointer, 0)
  258. End Sub
  259.  
  260. Private Sub UpdateItem(sText As String)
  261.     BugAssert sText <> sEmpty
  262. With cbo
  263.     Dim i As Integer, f As Boolean
  264.     For i = 0 To .ListCount - 1
  265.         ' If item is in list, remove in order to move to top
  266.         If .List(i) = sText Then .RemoveItem i
  267.     Next
  268.     ' Add item to top of list
  269.     .AddItem sText, 0
  270.     ' Remove any extra
  271.     If cMaxCount And .ListCount > cMaxCount Then
  272.         .RemoveItem cMaxCount
  273.     End If
  274.     ' Disable cbo_Click procedure
  275.     fInUpdate = True
  276.     ' Select new item
  277.     .ListIndex = 0
  278.     fInUpdate = False
  279.     fCompleted = True
  280.     RaiseEvent Completed(sText)
  281. End With
  282. End Sub
  283.